В этом модуле мы будем использовать библиотеку ggplot2 и plotly для создания интерактивной карты расстановки игроков на поле.

Функция отвечающая за отрисовку называется plot_scene. Она принимает в качестве аргументов:

Для отрисовки создается поле с разделенными по 10 ярдов зонами, двумя зонами тачдауна для каждой команды и линией положения мяча. В NFL используется игровое поле размером 100 на 53 ярда. Для предотврацения выхода за границы поле в функции ограничено - вылетающие значения обрезаются.

plot_scene <- function(offense_df, defense_df, ball_x, ball_y, title) {
  if (ball_x > 109){
    ball_x = 109
  }
  if(ball_x < 11){
    ball_x = 11
  }
  if (ball_y > 52){
    ball_y = 52
  }
  if(ball_y < 1){
    ball_y = 1
  }
  offense_df['role'] = 'offense'
  defense_df['role'] = 'defense'
  n_df <- rbind(offense_df, defense_df)
  ball <- data.frame(x=0, y=0, density=0, type='', Atype=0, role='ball')
  n_df <- rbind(n_df, ball)
  n_df$role <- as.factor(n_df$role)
  plt <- ggplot(n_df) + 
    annotate("rect", xmin=0, xmax=10, ymin=0, ymax=53, fill='red', alpha=.2) + 
    annotate("rect", xmin=110, xmax=120, ymin=0, ymax=53, fill='red', alpha=.2) + 
    annotate("rect", xmin=10, xmax=110, ymin=0, ymax=53, fill='green', alpha=.2) + 
    xlim(0, 120) + ylim(0, 53) + 
    geom_vline(xintercept=seq(0, 120, 10)) + 
    geom_vline(xintercept=ball_x, colour='red') +
    geom_hline(yintercept=seq(0, 53, 53)) + 
    geom_point(mapping=aes(x+ball_x, y+ball_y, colour=role), size=3) + 
    geom_text(mapping=aes(x+ball_x, y+ball_y, label=type), size=2.5) +
    ggtitle(title) +
    xlab("X") +
    ylab("Y") +
    labs(colour="Team") +
    scale_color_manual(values=c("#32CD32", "#6495ED", "#F08080"))
  ggplotly(plt)
}

Загрузка данных

Для моделирования положения игроков на поле используются данные

add_missing <- function(df, cur_max) {
  if(nrow(df) < cur_max){
      diff = cur_max - nrow(df)
      for (i in 1:diff) {
        dx = runif(1,0,1)
        dy = runif(1,-5,5)
        new <- list(x=df[i,]$x + dx, y=df[i,]$y + dy, density=df[i,]$density, type=df[i,]$type, Atype=df[i,]$Atype)
        df <- rbind(df, new)
      }
  } else {
    df <- df[1:cur_max,]
  }
  return(df)
}

Функция создания набора позиций по формации

formation_make <- function(type=0, formation) {
  bestper <- read.csv("bestper.csv")
  bestpossDef <- read.csv("bestpossDef.csv")
  bestpossDef <- bestpossDef[bestpossDef$density != 0,]
  bestpossA <- read.csv("bestpossA.csv")
  bestpossA <- bestpossA[bestpossA$density != 0,]
  if(type == 0){
    current <- bestper[bestper$offenseFormation == formation,]
    all_pos <- bestpossDef[bestpossDef$Atype == formation,]
    dl_pos <- all_pos[all_pos$type == 'DL',]
    if(nrow(dl_pos) == 0){
      dl_pos <- bestpossDef[bestpossDef$Atype == 'ALL' && bestpossDef$type == 'DL',]
    }
    lb_pos <- all_pos[all_pos$type == 'LB',]
    if(nrow(lb_pos) == 0){
      lb_pos <- bestpossDef[bestpossDef$Atype == 'ALL' && bestpossDef$type == 'LB',]
    }
    db_pos <- all_pos[all_pos$type == 'DB',]
    if(nrow(db_pos) == 0){
      db_pos <- bestpossDef[bestpossDef$Atype == 'ALL' && bestpossDef$type == 'DB',]
    }
    
    dl_pos <- add_missing(dl_pos, current$DL_def)
    lb_pos <- add_missing(lb_pos, current$LB_def)
    db_pos <- add_missing(db_pos, current$DB_def)
    
    field_df <- rbind(dl_pos, lb_pos, db_pos)
  } else {
    field_df <- bestpossA[bestpossA$Atype == formation,]
    if(nrow(field_df) > 10){
      field_df <- field_df[1:10,]
    }
  }
  return(field_df)
}

Использование

В качестве положений мяча будут координаты (75, 35), (100, 43), (34, 30)

l <- htmltools::tagList()
i = 1
for (form in c("ALL", "I_FORM", "JUMBO", "PISTOL", "SHOTGUN", "SINGLEBACK", "WILDCAT")) {
  def_df <- formation_make(type=0, formation = form)
  off_df <- formation_make(type=1, formation = form)
  l[[i]] <- as.widget(plot_scene(off_df, def_df, runif(1,5,105), runif(1, 10, 43), paste("Моделирование игры NFL -", form)))
  i = i+1
}
l

Следующая страница

Предыдущая страница